home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Amiga-E
/
E_v3.2a
/
Src
/
Various
/
SrcGen.e
< prev
next >
Wrap
Text File
|
1994-11-08
|
16KB
|
440 lines
/* GenGTXSource-E: SrcGen GadToolBox source generator for E
You'll be needing GadToolBox v2.0 or higher, and have the gadtoolsbox.library
that comes with it in your LIBS:. now, with GTB, make some simple example
(just a window with a few gadgets/menus etc.), save it as "bla" (filename will
be "bla.gui"), and type:
1> SrcGen bla
1> EC bla
1> bla
"bla.e" contains the routines for opening your interface, as well
as some routines to handle idcmpmessages, errors etc., and a dummy
"main" that just waits for one selection. here you can put in
your own code. see the commandline template how to stop SrcGen from
generating these routines.
That's all there's to it. If you have problems, just check the
source that has been generated.
TODO:
- check and implement all possible tags
- open screen.
- Wait4Message <-> IDCMP
- Other fonts than topaz-8 as gadgettext
- hotkey support?
- In gen of OpeWindowTaglist(): tag "AUTO_ADJUST,1," generated twice.
- does not generate code for reverse bevel boxes
*/
OPT OSVERSION=37
ENUM NONE,NOMEM,BADARGS,NOGTXLIB,LOADGUI,NOGUI,NOWINDOWS,NOFILEOUT
SET HASGADGETS,HASMENUS
MODULE 'gtx', 'gadtoolsbox/forms', 'gadtoolsbox/gui', 'gadtoolsbox/gtxbase',
'nofrag', 'libraries/gadtools', 'utility', 'intuition/gadgetclass',
'intuition/intuition'
DEF guiptr:guidata,
wlist:windowlist,
kinds:PTR TO LONG,
gttags1:PTR TO LONG,gttags2:PTR TO LONG,gatags:PTR TO LONG,
pgatags:PTR TO LONG,latags:PTR TO LONG,strtags:PTR TO LONG,
watags:PTR TO LONG,
win[100]:LIST,
infile[100]:STRING,outfile[100]:STRING,
mainf=TRUE,erf=TRUE,mesf=TRUE,layoutf=TRUE,
lastkind,wname
PROC main() HANDLE
DEF myargs:PTR TO LONG,rdargs=NIL,chain=NIL,gbase:PTR TO gtxbase,valid=NIL
myargs:=[0,0,0,0,0]
IF (rdargs:=ReadArgs('GUIFILE/A,NOMAIN/S,NOERR/S,NOMES/S,NOLAYOUT/S',myargs,NIL))=NIL THEN Raise(BADARGS)
WriteF('Amiga E GadToolsBox SourceGenerator v0.4 (c) 1993 $#%!\n')
IF (gtxbase:=OpenLibrary('gadtoolsbox.library',0))=NIL THEN Raise(NOGTXLIB)
IF myargs[1] THEN mainf:=FALSE /* generate no PROC main() */
IF myargs[2] THEN erf:=FALSE /* no error report function */
IF myargs[3] THEN mesf:=FALSE /* no wait4message() */
IF myargs[4] THEN layoutf:=FALSE /* no layout: all tags on one line */
StrCopy(infile,myargs[0],ALL)
StrCopy(outfile,infile,ALL)
StrAdd(infile,'.gui',ALL)
StrAdd(outfile,'.e',ALL)
gbase:=gtxbase
nofragbase:=gbase.nofragbase
utilitybase:=gbase.utilitybase
IF (chain:=GetMemoryChain(4096))=NIL THEN Raise(NOMEM)
IF GtX_LoadGUIA(chain,infile,[RG_GUI,guiptr,RG_WINDOWLIST,wlist,RG_VALID,{valid},NIL]) THEN Raise(LOADGUI)
IF (valid AND VLF_GUI)=0 THEN Raise(NOGUI)
IF (valid AND VLF_WINDOWLIST)=0 THEN Raise(NOWINDOWS)
WriteF('Generating source...\n\n')
generate()
Raise(NONE)
EXCEPT
IF valid AND VLF_WINDOWLIST THEN GtX_FreeWindows(chain,wlist)
IF chain THEN FreeMemoryChain(chain,TRUE)
IF gtxbase THEN CloseLibrary(gtxbase)
IF rdargs THEN FreeArgs(rdargs)
WriteF('\s!\n',ListItem(['Done',
'Out of Memory',
'Bad args',
'Could not open gadtoolsbox library',
'Problems reading GUI file',
'missing GUI definition',
'missing window definitions',
'problems while writing E source'],exception))
ENDPROC
PROC generate()
DEF fh
IF ( fh:=Open(outfile,NEWFILE) )=NIL THEN Raise(NOFILEOUT)
fh:=SetStdOut(fh)
initlists()
WriteF('/* E Source generated by SRCGEN v0.1 */\n\nOPT OSVERSION=37\n\n' +
'MODULE ''gadtools'',''libraries/gadtools'',''intuition/intuition' +
''',\n ''intuition/screens'', ''intuition/gadgetclass'', ''graphics/text''\n\n'+
'ENUM NONE,NOCONTEXT,NOGADGET,NOWB,NOVISUAL,OPENGT,NOWINDOW,NOMENUS\n\n')
WriteF('DEF')
checkwindows()
IF mesf THEN WriteF('\tinfos:PTR TO gadget,\n')
WriteF('\tscr:PTR TO screen,\n\tvisual=NIL,\n\toffx,offy,tattr\n\n')
genscreenstuff()
genwindows()
genmain()
Close(SetStdOut(fh))
ENDPROC
PROC genwindows()
DEF w:PTR TO projectwindow,wnum=0
w:=wlist.first
WHILE w.next
wname:=w.name
lastkind:=-1
WriteF('PROC open\swindow()\n',wname)
WriteF(' DEF g:PTR TO gadget\n')
WriteF(' IF (g:=CreateContext({\sglist}))=NIL THEN RETURN NOCONTEXT\n',wname)
gengadgets(w)
IF win[wnum] AND HASMENUS
WriteF(' IF (\smenus:=CreateMenusA([',wname)
genmenus(w.menus)
WriteF('0,0,0,0,0,0,0]:newmenu,NIL))=NIL THEN RETURN NOMENUS\n')
WriteF(' IF LayoutMenusA(\smenus,visual,NIL)=FALSE THEN RETURN NOMENUS\n',wname)
ENDIF
WriteF(' IF (\swnd:=OpenWindowTagList(NIL,',wname)
WriteF(IF layoutf THEN '\n [' ELSE '[')
createtags(w.tags)
IF win[wnum] AND HASGADGETS
WriteF('WA_GADGETS,\sglist,',wname)
IF layoutf THEN WriteF('\n ')
ENDIF
WriteF('NIL]))=NIL THEN RETURN NOWINDOW\n')
IF w.windowtext THEN gentexts(w.windowtext)
genboxes(w)
IF win[wnum] AND HASMENUS
WriteF(' IF SetMenuStrip(\swnd,\smenus)=FALSE THEN RETURN NOMENUS\n',wname,wname)
ENDIF
WriteF(' Gt_RefreshWindow(\swnd,NIL)\n',wname)
WriteF('ENDPROC\n\nPROC close\swindow()\n',wname)
IF win[wnum] AND HASMENUS
WriteF(' IF \swnd THEN ClearMenuStrip(\swnd)\n',wname,wname)
WriteF(' IF \smenus THEN FreeMenus(\smenus)\n',wname,wname)
ENDIF
WriteF(' IF \swnd THEN CloseWindow(\swnd)\n',wname,wname)
WriteF(' IF \sglist THEN FreeGadgets(\sglist)\n',wname,wname)
WriteF('ENDPROC\n\n')
w:=w.next
INC wnum
ENDWHILE
ENDPROC
PROC gengadgets(w:PTR TO projectwindow)
DEF egl:PTR TO extgadgetlist,eng:PTR TO extnewgadget,ng:PTR TO newgadget,kind
egl:=w.gadgets; eng:=egl.first
IF eng=NIL THEN RETURN
WHILE eng.next
ng:=eng.newgadget /* offx,offy */
kind:=eng.kind
WriteF(' IF (g:=CreateGadgetA(\s,g,',kinds[kind])
IF layoutf THEN WriteF('\n ')
WriteF('[offx+\d,offy+\d,\d,\d,''\s'',' +
'tattr,\d,\d,visual,0]:newgadget,',
ng.leftedge,ng.topedge,ng.width,ng.height,ng.gadgettext,
ng.gadgetid,ng.flags)
WriteF(IF layoutf THEN '\n [' ELSE '[')
createtags(eng.tags)
WriteF('NIL]))=NIL THEN RETURN NOGADGET\n')
lastkind:=kind
eng:=eng.next
ENDWHILE
ENDPROC
PROC genmenus(eml:PTR TO extmenulist)
DEF enm:PTR TO extnewmenu,nm:PTR TO newmenu,ckey[10]:STRING
enm:=eml.first
IF enm=NIL THEN RETURN
WHILE enm.next
nm:=enm.newmenu
IF nm.commkey THEN StringF(ckey,'''\s''',nm.commkey) ELSE StrCopy(ckey,'0',ALL)
WriteF('\d,0,',nm.type)
WriteF(IF StrCmp(enm.menutitle,'NM_BARLABEL') THEN '-1' ELSE '''\s''',enm.menutitle)
WriteF(',\s,$\h,\d,\d,',ckey,nm.flags,nm.mutualexclude,nm.userdata)
IF layoutf THEN WriteF('\n ')
IF enm.items THEN genmenus(enm.items)
enm:=enm.next
ENDWHILE
ENDPROC
PROC gentexts(i:PTR TO intuitext)
WriteF(' PrintIText(\swnd.rport,',wname)
IF layoutf THEN WriteF('\n ')
WriteF('[\d,\d,\d,\d,\d,tattr,''\s'',NIL]' +
':intuitext,offx,offy)\n',i.frontpen,i.backpen,
i.drawmode,i.leftedge,i.topedge,i.itext)
IF i.nexttext THEN gentexts(i.nexttext)
ENDPROC
PROC genboxes(w:PTR TO projectwindow)
DEF bl:PTR TO bevellist,bb:PTR TO bevelbox
bl:=w.boxes; bb:=bl.first
IF bb=NIL THEN RETURN
WHILE bb.next
WriteF(' DrawBevelBoxA(\swnd.rport,\d+offx,\d+offy,\d,\d,',wname,bb.left,bb.top,bb.width,bb.height)
IF layoutf THEN WriteF('\n ')
WriteF('[GT_VISUALINFO,visual,')
IF bb.flags AND BBF_RECESSED THEN WriteF('GTBB_RECESSED,1,')
WriteF('NIL])\n')
bb:=bb.next
ENDWHILE
ENDPROC
PROC createtags(taglist)
DEF tag:PTR TO LONG,item,str1=NIL,v:PTR TO LONG,type=0
WHILE tag:=NextTagItem({taglist})
item:=tag[0]
IF (item>GT_TAGBASE) AND (GT_TAGBASE+65>item)
item:=item-GT_TAGBASE
IF (item>=4) AND (item<=24)
item:=item-4*2
str1:=gttags1[item]
type:=gttags1[item+1]
ELSEIF (item>=38) AND (item<=64)
item:=item-38*2
str1:=gttags2[item]
type:=gttags2[item+1]
ENDIF
ELSEIF (item>GA_DUMMY) AND (GA_DUMMY+25>item)
item:=item-GA_DUMMY-1*2
str1:=gatags[item]
type:=gatags[item+1]
ELSEIF (item>PGA_DUMMY) AND (PGA_DUMMY+11>item)
item:=item-PGA_DUMMY-1*2
str1:=pgatags[item]
type:=pgatags[item+1]
ELSEIF (item>STRINGA_DUMMY) AND (STRINGA_DUMMY+$13>item)
item:=item-STRINGA_DUMMY-1*2
str1:=strtags[item]
type:=strtags[item+1]
ELSEIF (item>LAYOUTA_DUMMY) AND (LAYOUTA_DUMMY+25>item)
item:=item-LAYOUTA_DUMMY-1*2
str1:=latags[item]
type:=latags[item+1]
ELSEIF (item>=$80000064) AND (item<=$80000092)
item:=item-$80000064*2
str1:=watags[item]
type:=watags[item+1]
ENDIF
WriteF(IF str1 THEN str1 ELSE '$\h',tag[0])
WriteF(',')
v:=tag[1]
/* 0=num, 1=(list), 2=array of text, 3=text, 4="NIL", 5="tattr", 6="visual"
7="g/NIL", 8=(ptr to menu), 9="scr", 10="_", 11="+offx", 12="+offy" */
SELECT type
CASE 0
WriteF(IF (v>=-100) AND (v<=500) THEN '\d' ELSE '$\h',v)
CASE 2
WriteF('[')
WHILE v[]
WriteF('''\s'',',v[])
v++
ENDWHILE
WriteF('0]')
CASE 3; WriteF('''\s''',v)
CASE 5; WriteF('tattr')
CASE 6; WriteF('visual')
CASE 7; WriteF(IF lastkind=STRING_KIND THEN 'g' ELSE 'NIL')
CASE 9; WriteF('scr')
CASE 10; WriteF('"_"')
CASE 11; WriteF('offx+\d',v)
CASE 12; WriteF('offy+\d',v)
DEFAULT; WriteF('NIL')
ENDSELECT
WriteF(',')
IF layoutf THEN WriteF('\n ')
ENDWHILE
ENDPROC
PROC checkwindows()
DEF w:PTR TO projectwindow,wname,fl,x
w:=wlist.first
WHILE w.next
wname:=w.name
LowerStr(wname)
fl:=0
WriteF('\t\swnd:PTR TO window,\n',wname)
x:=Long(w.menus)
IF ^x
fl:=HASMENUS
WriteF('\t\smenus,\n',wname)
ENDIF
x:=Long(w.gadgets)
IF ^x
fl:=fl OR HASGADGETS
ENDIF
WriteF('\t\sglist,\n',wname)
ListAdd(win,[fl],ALL)
w:=w.next
ENDWHILE
ENDPROC
PROC genscreenstuff()
WriteF('PROC setupscreen()\n IF (gadtoolsbase:=OpenLibrary(''gadtools' +
'.library'',37))=NIL THEN RETURN OPENGT\n IF (scr:=LockPubScreen(''' +
'Workbench''))=NIL THEN RETURN NOWB\n IF (visual:=GetVisualInfoA(sc' +
'r,NIL))=NIL THEN RETURN NOVISUAL\n offy:=scr.wbortop+Int(scr.rastp' +
'ort+58)-10\n tattr:=[''topaz.font'',8,0,0]:textattr\nENDPROC\n\nPR' +
'OC closedownscreen()\n IF visual THEN FreeVisualInfo(visual)\n IF' +
' scr THEN UnlockPubScreen(NIL,scr)\n IF gadtoolsbase THEN CloseLib' +
'rary(gadtoolsbase)\nENDPROC\n\n')
ENDPROC
PROC genmain()
DEF w:PTR TO projectwindow,wname
IF mesf
WriteF('PROC wait4message(win:PTR TO window)\n' +
' DEF mes:PTR TO intuimessage,type\n' +
' REPEAT\n' +
' type:=0\n' +
' IF mes:=Gt_GetIMsg(win.userport)\n' +
' type:=mes.class\n' +
' IF type=IDCMP_MENUPICK\n' +
' infos:=mes.code\n' +
' ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)\n' +
' infos:=mes.iaddress\n' +
' ELSEIF type=IDCMP_REFRESHWINDOW\n' +
' Gt_BeginRefresh(win)\n' +
' Gt_EndRefresh(win,TRUE)\n' +
' type:=0\n' +
' ELSEIF type<>IDCMP_CLOSEWINDOW /* remove these if you like */\n' +
' type:=0\n' +
' ENDIF\n' +
' Gt_ReplyIMsg(mes)\n' +
' ELSE\n' +
' WaitPort(win.userport)\n' +
' ENDIF\n' +
' UNTIL type\n' +
'ENDPROC type\n\n')
ENDIF
IF erf
WriteF('PROC reporterr(er)\n DEF erlist:PTR TO LONG\n IF er\n' +
' erlist:=[''get context'',''create gadget'',''lock wb'',''get visual' +
' infos'',\n ''open "gadtools.library" v37+'',''open window'',''create menus'']\n' +
' EasyRequestArgs(0,[20,0,0,''Could not \\s!'',''ok''],0,[erlist[er-1]])\n' +
' ENDIF\nENDPROC er\n\n')
ENDIF
IF mainf
WriteF('PROC main()\n ')
WriteF(IF erf THEN 'IF reporterr(setupscreen())=0\n' ELSE 'IF setupscreen()=0\n')
w:=wlist.first
WHILE w.next
wname:=w.name
WriteF(IF erf THEN ' reporterr(open\swindow())\n' ELSE ' open\swindow()\n',wname)
WriteF(IF mesf THEN ' wait4message(\swnd)\n' ELSE ' Delay(500)\n',wname)
WriteF(' close\swindow()\n',wname)
WriteF(' IF CtrlC() THEN BRA x\n')
w:=w.next
ENDWHILE
WriteF(' ENDIF\n x: closedownscreen()\nENDPROC\n\n')
ENDIF
ENDPROC
PROC initlists()
kinds:=['GENERIC_KIND','BUTTON_KIND','CHECKBOX_KIND','INTEGER_KIND',
'LISTVIEW_KIND','MX_KIND','NUMBER_KIND','CYCLE_KIND','PALETTE_KIND',
'SCROLLER_KIND','RESERVED_KIND','SLIDER_KIND','STRING_KIND','TEXT_KIND']
/* GT_TAGBASE 4-23 */
gttags1:=['GTCB_CHECKED',0,'GTLV_TOP',0,'GTLV_LABELS',1,'GTLV_READONLY',0,
'GTLV_SCROLLWIDTH',0,'GTMX_LABELS',2,'GTMX_ACTIVE',0,'GTTX_TEXT',3,
'GTTX_COPYTEXT',0,'GTNM_NUMBER',0,'GTCY_LABELS',2,'GTCY_ACTIVE',0,
'GTPA_DEPTH',0,'GTPA_COLOR',0,'GTPA_COLOROFFSET',0,
'GTPA_INDICATORWIDTH',0,'GTPA_INDICATORHEIGHT',0,'GTSC_TOP',0,
'GTSC_TOTAL',0,'GTSC_VISIBLE',0]
/* GT_TAGBASE 38-64 */
gttags2:=['GTSL_MIN',0,'GTSL_MAX',0,'GTSL_LEVEL',0,'GTSL_MAXLEVELLEN',0,
'GTSL_LEVELFORMAT',3,'GTSL_LEVELPLACE',0,'GTSL_DISPFUNC',4,
'GTST_STRING',3,'GTST_MAXCHARS',0,'GTIN_NUMBER',0,
'GTIN_MAXCHARS',0,'GTMN_TEXTATTR',5,'GTMN_FRONTPEN',0,
'GTBB_RECESSED',0,'GT_VISUALINFO',6,'GTLV_SHOWSELECTED',7,
'GTLV_SELECTED',0,'GT_RESERVED0',0,'GT_RESERVED1',0,
'GTTX_BORDER',0,'GTNM_BORDER',0,'GTSC_ARROWS',0,'GTMN_MENU',8,
'GTMX_SPACING',0,'GTMN_FULLMENU',0,'GTMN_SECONDARYERROR',4,
'GT_UNDERSCORE',10]
/* GA_DUMMY 1-$24 */
gatags:=['GA_LEFT',0,'GA_RELRIGHT',0,'GA_TOP',0,'GA_RELBOTTOM',0,
'GA_WIDTH',0,'GA_RELWIDTH',0,'GA_HEIGHT',0,'GA_RELHEIGHT',0,
'GA_TEXT',0,'GA_IMAGE',0,'GA_BORDER',0,'GA_SELECTRENDER',0,
'GA_HIGHLIGHT',0,'GA_DISABLED',0,'GA_GZZGADGET',0,'GA_ID',0,
'GA_USERDATA',0,'GA_SPECIALINFO',0,'GA_SELECTED',0,
'GA_ENDGADGET',0,'GA_IMMEDIATE',0,'GA_RELVERIFY',0,
'GA_FOLLOWMOUSE',0,'GA_RIGHTBORDER',0,'GA_LEFTBORDER',0,
'GA_TOPBORDER',0,'GA_BOTTOMBORDER',0,'GA_TOGGLESELECT',0,
'GA_SYSGADGET',0,'GA_SYSGTYPE',0,'GA_PREVIOUS',0,'GA_NEXT',0,
'GA_DRAWINFO',0,'GA_INTUITEXT',0,'GA_LABELIMAGE',0,'GA_TABCYCLE',0]
/* PGADUMMY, 1-$A */
pgatags:=['PGA_FREEDOM',0,'PGA_BORDERLESS',0,'PGA_HORIZPOT',0,
'PGA_HORIZBODY',0,'PGA_VERTPOT',0,'PGA_VERTBODY',0,'PGA_TOTAL',0,
'PGA_VISIBLE',0,'PGA_TOP',0,'PGA_NEWLOOK',0]
/* STRINGA_DUMMY, 1-$13 */
strtags:=['STRINGA_MAXCHARS',0,'STRINGA_BUFFER',0,'STRINGA_UNDOBUFFER',0,
'STRINGA_WORKBUFFER',0,'STRINGA_BUFFERPOS',0,'STRINGA_DISPPOS',0,
'STRINGA_ALTKEYMAP',0,'STRINGA_FONT',0,'STRINGA_PENS',0,
'STRINGA_ACTIVEPENS',0,'STRINGA_EDITHOOK',0,'STRINGA_EDITMODES',0,
'STRINGA_REPLACEMODE',0,'STRINGA_FIXEDFIELDMODE',0,
'STRINGA_NOFILTERMODE',0,'STRINGA_JUSTIFICATION',0,
'STRINGA_LONGVAL',0,'STRINGA_TEXTVAL',0,'STRINGA_EXITHELP',0]
/* LAYOUTA_DUMMY 1-3 */
latags:=['LAYOUTA_LAYOUTOBJ',0,'LAYOUTA_SPACING',0,'LAYOUTA_ORIENTATION',0]
/* $8000000, $64-$92 */
watags:=['WA_LEFT',0,'WA_TOP',0,'WA_WIDTH',11,'WA_HEIGHT',12,'WA_DETAILPEN',0,
'WA_BLOCKPEN',0,'WA_IDCMP',0,'WA_FLAGS',0,'WA_GADGETS',0,
'WA_CHECKMARK',0,'WA_TITLE',3,'WA_SCREENTITLE',0,
'WA_CUSTOMSCREEN',9,'WA_SUPERBITMAP',0,'WA_MINWIDTH',0,
'WA_MINHEIGHT',0,'WA_MAXWIDTH',0,'WA_MAXHEIGHT',0,'WA_INNERWIDTH',0,
'WA_INNERHEIGHT',0,'WA_PUBSCREENNAME',0,'WA_PUBSCREEN',0,
'WA_PUBSCREENFALLBACK',0,'WA_WINDOWNAME',0,'WA_COLORS',0,
'WA_ZOOM',0,'WA_MOUSEQUEUE',0,'WA_BACKFILL',0,'WA_RPTQUEUE',0,
'WA_SIZEGADGET',0,'WA_DRAGBAR',0,'WA_DEPTHGADGET',0,
'WA_CLOSEGADGET',0,'WA_BACKDROP',0,'WA_REPORTMOUSE',0,
'WA_NOCAREREFRESH',0,'WA_BORDERLESS',0,'WA_ACTIVATE',0,
'WA_RMBTRAP',0,'WA_WBENCHWINDOW',0,'WA_SIMPLEREFRESH',0,
'WA_SMARTREFRESH',0,'WA_SIZEBRIGHT',0,'WA_SIZEBBOTTOM',0,
'WA_AUTOADJUST',0,'WA_GIMMEZEROZERO',0,'WA_MENUHELP',0]
ENDPROC